home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / packet / terminal / top_152 / src152.exe / rar / TOPAUS.PAS < prev    next >
Pascal/Delphi Source File  |  1995-05-16  |  29KB  |  966 lines
  1. {┌─────────────────────────────────────────────────────────────────────────┐}
  2. {│                                                                         │}
  3. {│                              T. O. P.                                   │}
  4. {│                                                                         │}
  5. {│                        (T)he  (O)ther  (P)acket                         │}
  6. {│                                                                         │}
  7. {│ T O P A U S . P A S                                                     │}
  8. {│                                                                         │}
  9. {│                                                                         │}
  10. {│                                                                         │}
  11. {│ Routinen für diverse Ausgaben. (Bildschirm, Morsezeichen ... usw.)      │}
  12. {│ Desweiteren Speicherung der Backsrolltexte.                             │}
  13. {│                                                                         │}
  14. {└─────────────────────────────────────────────────────────────────────────┘}
  15.  
  16.  
  17. Procedure Scroll (* Art : str2; Aufruf,Y1,Y2 : Byte *);  (* Video-Ram scrollen *)
  18. Var       i  : Byte;
  19. Begin
  20.   if not ((Aufruf = 0) and BackScroll(show)) then
  21.   begin
  22.     if Art = Up then    { Aufwärts scrollen }
  23.     begin
  24.       if ScrollVor or not NowFenster or ((Y2 = maxZ) and (show > 0)) then
  25.          move(Bild^[Y1*160+1],Bild^[((Y1-1)*160)+1],(Y2-Y1)*160) else
  26.       begin
  27.         for i := 0 to 2 do  { nur links und rechts vom Fenster wird gescrollt }
  28.         begin
  29.           move(Bild^[(Y1+i)*160+1],Bild^[((Y1-1+i)*160)+1],(XL-1)*2);
  30.           move(Bild^[(Y1+i)*160+1+2*(XR-1)],Bild^[((Y1-1+i)*160)+1+2*(XR-1)],(81-XR)*2);
  31.         end;  { Unter dem Fenster werden wieder alle Zeilen komplett gescrollt }
  32.         if Y2-Y1-3 > 0 then
  33.          move(Bild^[(Y1+3)*160+1],Bild^[((Y1+2)*160)+1],(Y2-Y1-3)*160);
  34.       end;                                                   { Abwärts scrollen }
  35.     end else move(Bild^[((Y1-1)*160)+1],Bild^[(Y1)*160+1],(Y2-Y1)*160);
  36.     ScrollVor := false;
  37.   end;
  38. End;
  39.  
  40.  
  41. Procedure _aus (* Attr,Kanal : Byte; Zeile : String *);
  42. Var  i,X2M   : Byte;
  43.      ch      : Char;
  44.      Aktuell : Boolean;
  45.      Hstr    : String[80];
  46.  
  47. Begin
  48.   Aktuell := (Kanal = show) and not BackScroll(Kanal);
  49.  
  50.   with K[Kanal]^ do
  51.   Begin
  52.     While pos(^J,Zeile) > 0 do delete(Zeile,pos(^J,Zeile),1);
  53.  
  54.     Hstr := '';
  55.     X2M := X2;
  56.  
  57.     if Save and not RX_Save then Write_SFile(Kanal,Zeile);
  58.     if Drucker then Write_Drucker(Kanal,Zeile);
  59.     Zeile := Line_Convert(Kanal,2,Zeile);
  60.  
  61.     if (pos(^G,Zeile) > 0) and
  62.        not(Ignore or RX_Save or EigFlag or RemFlag or FileFlag or Mo.MonActive) and
  63.        TNC_ReadOut and CtrlBeep then Beep(G^.CTRL_G_Freq,G^.CTRL_G_Time);
  64.  
  65.     if Rx_Beep and Aktuell and Klingel then
  66.     begin
  67.       LockIntFlag(0);
  68.       Beep(G^.RxPiepFreq,G^.RxPiepTime);
  69.       LockIntFlag(1);
  70.     end;
  71.  
  72.     for i := 1 to ord(Zeile[0]) do
  73.     begin
  74.       ch := Zeile[i];
  75.       if ch = #0 then ch := #255;
  76.  
  77.       if RxLRet then
  78.       begin
  79.         if (X2 > 80) and (ch = M1) then ch := ^J;
  80.         Write_Notstr(Kanal,M1);
  81.         Write_Notstr(Kanal,chr(ChAttr(Attr)));
  82.  
  83.         if Aktuell then
  84.         begin
  85.           if Hstr > '' then
  86.             if BiosOut then WriteBios(Kanal,X2M,QEnd,Attr,0,Hstr)
  87.                        else WritePage(Kanal,X2M,QEnd,Attr,0,Hstr);
  88.           Scroll(Up,0,QBeg,QEnd);
  89.           WriteRam(1,QEnd,Attr,0,G^.Leer);
  90.         end;
  91.  
  92.         if (NeueZeilen < N999) then inc(NeueZeilen);
  93.  
  94.         Hstr := '';
  95.         X2M := 1;
  96.         X2 := 1;
  97.       end;
  98.  
  99.       RxLRet := false;
  100.  
  101.       if ch = M1 then RxLRet := true else
  102.       if ch <> ^J then
  103.       begin
  104.         Write_Notstr(Kanal,ch);
  105.         Hstr := Hstr + ch;
  106.         inc(X2);
  107.         if X2 > 80 then RxLRet := true;
  108.       end;
  109.     end; (* for i := ... *)
  110.  
  111.     Write_Notiz(Kanal);
  112.     if (Hstr > '') and Aktuell then
  113.             if BiosOut then WriteBios(Kanal,X2M,QEnd,Attr,0,Hstr)
  114.                        else WritePage(Kanal,X2M,QEnd,Attr,0,Hstr);
  115.   End;
  116. End;
  117.  
  118.  
  119. Procedure M_aus (* Attr : Byte; Zeile : String *);
  120. Var  i,X2M    : Byte;
  121.      ch       : Char;
  122.      Hstr     : String[80];
  123.      Flag,
  124.      Output,
  125.      Aktuell  : Boolean;
  126.  
  127.   
  128. Begin
  129.   Aktuell := show = 0;
  130.   Output := ((K[show]^.UnStat < maxZ) or Aktuell) and not Backscroll(0);
  131.  
  132.   with K[0]^ do
  133.   Begin
  134.     if Save then Write_SFile(0,Zeile);
  135.     if Drucker then Write_Drucker(0,Zeile);
  136.     Zeile := Line_Convert(0,2,Zeile);
  137.  
  138.     Hstr := '';
  139.     X2M := X2;
  140.     Flag := false;
  141.  
  142.     for i := 1 to ord(Zeile[0]) do
  143.     begin
  144.       ch := Zeile[i];
  145.       if ch = #0 then ch := #255;
  146.  
  147.       if RxLRet then
  148.       begin
  149.         if (X2 > 80) and ((ch = M1) or (ch = ^J)) then Flag := true;
  150.         Write_Notstr(0,M1);
  151.         Write_Notstr(0,chr(ChAttr(Attr)));
  152.  
  153.         if Output then
  154.         begin
  155.           if Hstr > '' then WritePage(0,X2M,maxZ,Attr,1,Hstr);
  156.           if Aktuell then Scroll(Up,0,UnStat+1,maxZ)
  157.                      else Scroll(Up,1,K[show]^.UnStat+1,maxZ);
  158.           WriteRam(1,maxZ,Attr,1,G^.Leer);
  159.         end;
  160.  
  161.         if (NeueZeilen < N999) then inc(NeueZeilen);
  162.  
  163.         Hstr := '';
  164.         X2 := 1;
  165.         X2M := 1;
  166.       end;
  167.  
  168.       RxLRet := false;
  169.  
  170.       if (ch = ^J) or (ch = M1) then
  171.       begin
  172.         if not Flag then RxLRet := true;
  173.         if ZeigeRet and (ch = M1) then
  174.         begin
  175.           RxLRet := true;
  176.           Write_Notstr(0,^J);
  177.           Hstr := Hstr + ^J;
  178.           inc(X2);
  179.         end;
  180.       end else if not Flag then
  181.       begin
  182.         Write_Notstr(0,ch);
  183.         Hstr := Hstr + ch;
  184.         inc(X2);
  185.         if X2 > 80 then RxLRet := true;
  186.       end;
  187.  
  188.       Flag := false;
  189.     end; 
  190.  
  191.     Write_Notiz(0);
  192.     if (Hstr > '') and Output then WritePage(0,X2M,maxZ,Attr,1,Hstr);
  193.   end;
  194. End;
  195.  
  196.  
  197. Procedure Write_Notiz;    (* Kanal : Integer *)
  198. var    l    : Byte;
  199.        i    : Word;
  200.        i1   : Integer;
  201.        Hstr : string;
  202. Begin
  203.   with K[Kanal]^ do
  204.   begin
  205.     l := ord(NZeile[0]);
  206.     if use_EMS then EMS_Seite_einblenden(Kanal,Scr);
  207.     if use_Vdisk then Open_Scroll(Kanal);
  208.     if NotPos + l > (maxNotCh-1) then
  209.     begin
  210.       i1 := NotPos + l - (maxNotCh-1);
  211.       if use_Vdisk then
  212.       begin
  213.         Hstr := copy(NZeile,1,(maxNotCh-1)-NotPos);
  214.         BlockWrite(ScrollFile,Hstr[1],length(Hstr),i);
  215.         delete(NZeile,1,(maxNotCh-1)-NotPos);
  216.         Seek(ScrollFile,Pos_im_Scr);
  217.         BlockWrite(ScrollFile,NZeile[1],length(NZeile),i);
  218.       end else
  219.       if use_XMS then
  220.       begin
  221.         Data_to_XMS(@NZeile[1],XMS_Handle,Pos_im_Scr+NotPos,(maxNotCh-1)-NotPos);
  222.         Data_to_XMS(@NZeile[(maxNotCh-1)-NotPos+1],XMS_Handle,Pos_im_Scr,i1);
  223.         NotPos := i1;
  224.       end else
  225.       begin
  226.         move(NZeile[1],NotCh[Kanal]^[NotPos],(maxNotCh-1)-NotPos);
  227.         move(NZeile[(maxNotCh-1)-NotPos+1],NotCh[Kanal]^[0],i1);
  228.         NotPos := i1;
  229.       end;
  230.     end else
  231.     begin
  232.       if use_Vdisk then
  233.       begin
  234.         BlockWrite(ScrollFile,NZeile[1],l,i);
  235.       end else if use_XMS then
  236.       begin
  237.         Data_to_XMS(@NZeile[1],XMS_Handle,Pos_im_Scr+NotPos,l);
  238.         NotPos := NotPos + l;
  239.       end else
  240.       begin
  241.         move(NZeile[1],NotCh[Kanal]^[NotPos],l);
  242.         NotPos := NotPos + l;
  243.       end;
  244.     end;
  245.     if use_Vdisk then Close_Scroll(Kanal);
  246.     NZeile := '';
  247.   end; { with }
  248. End;
  249.  
  250. Procedure Write_Notstr (* Kanal : Byte; ch : char *);
  251. Begin
  252.   with K[Kanal]^ do
  253.   begin
  254.     if length(NZeile) >= 255 then Write_Notiz(Kanal);
  255.     NZeile := NZeile + ch;
  256.   end;
  257. End;
  258.  
  259.  
  260. Procedure Write_BoxStr (* Kanal,Art : Byte *);
  261. Var  Zstr      : String[40];
  262.      Ach       : Char;
  263.      i,lp      : Byte;
  264.      Result    : Word;
  265.      Nr        : LongInt;
  266.      RubHeader,
  267.      RunHeader,
  268.      Checks,
  269.      Lists     : Boolean;
  270. Begin
  271.   Checks := false;
  272.   Lists := false;
  273.   RubHeader := false;
  274.   RunHeader := false;
  275.   lp := 1;
  276.   FillChar(G^.MlStr,SizeOf(G^.MlStr),0);
  277.   Zstr := '';
  278.   Ach := 'U';
  279.  
  280.   with K[Kanal]^ do
  281.   begin
  282.     if Art = 0 then
  283.     begin
  284.       if SCon[2] then   (* BBOX *)
  285.       begin
  286.         i := pos(') ',BoxStr);
  287.         if (i > 0) and (i < 8) and (pos('(',BoxStr) <> 1) then BoxStr[i] := B1;
  288.  
  289.         i := pos('R ',BoxStr);
  290.         if (i > 0) and (i < 8) and (str_int(copy(BoxStr,1,i-1)) > 0) then
  291.         begin
  292.           BoxStr[i] := B1;
  293.           BoxStr[i+1] := 'r';
  294.         end;
  295.  
  296.         i := pos('F ',BoxStr);
  297.         if (i > 0) and (i < 8) and (str_int(copy(BoxStr,1,i-1)) > 0) then
  298.         begin
  299.           BoxStr[i] := B1;
  300.           BoxStr[i+1] := 'f';
  301.         end;
  302.  
  303.         i := pos('E ',BoxStr);
  304.         if (i > 0) and (i < 8) and (str_int(copy(BoxStr,1,i-1)) > 0) then
  305.         begin
  306.           BoxStr[i] := B1;
  307.           BoxStr[i+1] := 'e';
  308.         end;
  309.       end;
  310.  
  311.       for i := 1 to maxBlBox do
  312.       begin
  313.         G^.MlStr[i] := ParmStr(i,B1,BoxStr);
  314.         if length(G^.MlStr[i]) > 0 then lp := i;
  315.       end;
  316.       Nr := LongInt(str_int(G^.MlStr[1]));
  317.  
  318.       if Nr > 0 then  (* Hier war die erste Sequenz eine Nummer *)
  319.       begin
  320.         if SCon[1] or SCon[2] or SCon[14] then   (* DBOX oder BBOX oder TBOX im Connect *)
  321.         begin
  322.           if (G^.MlStr[3] = '>') and (copy(G^.MlStr[5],3,1) = Pkt ) and
  323.              (copy(G^.MlStr[5],6,1) = Pkt ) then
  324.           begin
  325.             Checks := true;
  326.             Ach := 'C';
  327.             Rubrik := copy(G^.MlStr[4],1,8);
  328.             i := pos(Pkt ,Rubrik);
  329.             if i > 0 then Rubrik := copy(Rubrik,1,i-1);
  330.             Rubrik := EFillStr(8,B1,Rubrik);
  331.           end else if (copy(G^.MlStr[3],3,1) = Pkt ) and (copy(G^.MlStr[3],6,1) = Pkt ) and
  332.                       (str_int(G^.MlStr[5]) > 0) then
  333.                    begin
  334.                      Lists := true;
  335.                      Ach := 'L';
  336.                    end;
  337.         end;
  338.  
  339.         if SCon[3] then  (* FBOX *)
  340.         begin
  341.           if (pos('P',BoxStr) in [7..10]) or (pos('B',BoxStr) in [7..10]) and
  342.             (LongInt(str_int(G^.MlStr[1])) > 0) then
  343.           begin
  344.             Lists := true;
  345.             Rubrik := ConstStr(B1,8);
  346.             Ach := 'L';
  347.           end;
  348.         end;
  349.  
  350.         if SCon[4] then  (* WBOX *)
  351.         begin
  352.           if (pos('@',BoxStr) = 22) and
  353.              (LongInt(str_int(G^.MlStr[2])) > 0) then
  354.           begin
  355.             Checks := true;
  356.             Ach := 'C';
  357.             Rubrik := EFillStr(8,B1,copy(BoxStr,14,8));
  358.           end;
  359.         end;
  360.  
  361.         if SCon[5] then  (* EBOX *)  (* Die EBOX ist nur eine lokale Box *)
  362.         begin
  363.           Zstr := UpCaseStr(G^.MlStr[8]);
  364.           if (Word(str_int(G^.MlStr[2])) > 0) and
  365.              (Word(str_int(G^.MlStr[7])) > 0) and
  366.              ((Zstr = 'T') or (Zstr = 'D')) then
  367.           begin
  368.             Lists := true;
  369.             Rubrik := ConstStr(B1,8);
  370.             Ach := 'L';
  371.           end;
  372.         end;
  373.       end else
  374.  
  375.       begin
  376.         if SCon[1] or SCon[2] then   (* DBox + BBox *)
  377.         begin
  378.           if ((pos(G^.BinEL,BoxStr) = 1) or (pos(G^.TxtEL,BoxStr) = 1)) and
  379.               (LongInt(str_int(G^.MlStr[3])) > 0) then
  380.           begin
  381.             BoxStr := EFillStr(45,B1,RunRub + G^.MlStr[2]) +
  382.                       SFillStr(8,B1,G^.MlStr[3]) + B1 + OneByte + B1 +
  383.                       copy(G^.MlStr[5],1,6) +
  384.                       copy(G^.MlStr[5],9,2) + B1 +
  385.                       copy(G^.MlStr[6],1,5) + B1 +
  386.                       G^.MlStr[1];
  387.             Ach := 'R';
  388.             Lists := true;
  389.           end else
  390.  
  391.           if ((pos(G^.BinEL,BoxStr) = 1) or (pos(G^.TxtEL,BoxStr) = 1)) and
  392.               (LongInt(str_int(G^.MlStr[2])) > 0) then
  393.           begin
  394.             BoxStr := EFillStr(45,B1,G^.MlStr[5]) +
  395.                       SFillStr(8,B1,G^.MlStr[2]) + B1 + OneByte + B1 +
  396.                       EFillStr(15,B1,G^.MlStr[4]) +
  397.                       G^.MlStr[1];
  398.             Ach := 'R';
  399.             Lists := true;
  400.           end else
  401.  
  402.           if  (pos(G^.DirEL,BoxStr) = 1) and
  403.               (copy(G^.MlStr[2],length(G^.MlStr[2]),1) = BS ) and
  404.               (pos(Pkt ,G^.MlStr[4]) = 3) and
  405.               (pos(DP,G^.MlStr[5]) = 3) then
  406.           begin
  407.             BoxStr := EFillStr(74,B1,RunRub + G^.MlStr[2]) + CutStr(BoxStr);
  408.             Ach := 'V';
  409.             Lists := true;
  410.           end else
  411.  
  412.           if (copy(BoxStr,length(G^.MlStr[1]),1) = BS ) and
  413.              (pos('Datei',G^.MlStr[3]) = 1) and
  414.              (G^.MlStr[5] = OneByte) and
  415.              (pos('Unterverzeichnis',G^.MlStr[7]) = 1) then
  416.           begin
  417.             BoxStr := EFillStr(40,B1,RunRub + CutStr(BoxStr)) +
  418.                       SFillStr(3,B1,int_str(str_int(G^.MlStr[2]))) + B1 + Files + B1 +
  419.                       SFillStr(8,B1,G^.MlStr[4]) + B1 + OneByte +
  420.                       SFillStr(4,B1,int_str(str_int(G^.MlStr[6]))) + B1 + DIRs;
  421.             Ach := 'V';
  422.             Lists := true;
  423.           end else
  424.  
  425.           if (copy(BoxStr,3,1) = Pkt ) and
  426.              (copy(BoxStr,6,1) = Pkt ) and
  427.              (copy(BoxStr,11,2) = '  ') and
  428.              (pos(':\',G^.MlStr[2]) = 2) and
  429.              (pos(B1,G^.MlStr[2]) = 0) then
  430.           begin
  431.             BoxStr := RestStr(BoxStr);
  432.             Ach := 'V';
  433.             Lists := true;
  434.           end else
  435.  
  436.           if pos(G^.RunElFile,BoxStr) = 1 then
  437.           begin
  438.             { Dateien im Unterverzeichnis: D:\DISKTOOL\*.* }
  439.             RunRub := G^.MlStr[lp];
  440.             While (RunRub[0] > #0) and (RunRub[Ord(RunRub[0])] <> BS )
  441.                do RunRub[0] := Chr(Ord(RunRub[0])-1);
  442.             Rubrik := ConstStr(B1,8);
  443.             RubHeader := true;
  444.             RunHeader := true;
  445.           end else
  446.  
  447.           if pos(G^.RunElDir,BoxStr) = 1 then
  448.           begin
  449.             { Unterverzeichnisse von: D:\*.* }
  450.             RunRub := G^.MlStr[lp];
  451.             While (RunRub[0] > #0) and (RunRub[Ord(RunRub[0])] <> BS )
  452.                do RunRub[0] := Chr(Ord(RunRub[0])-1);
  453.             Rubrik := ConstStr(B1,8);
  454.             RubHeader := true;
  455.             RunHeader := true;
  456.           end else
  457.  
  458.           if pos(G^.RunElTree,BoxStr) = 1 then
  459.           begin
  460.             { Verzeichnisbaum fuer EL-Laufwerk/EL-Pfad: D:\EL\ }
  461.             RunRub := G^.MlStr[lp];
  462.             Rubrik := ConstStr(B1,8);
  463.             RubHeader := true;
  464.             RunHeader := true;
  465.           end;
  466.         end;
  467.  
  468.         if SCon[1] then   (* DBox *)
  469.         begin
  470.           if (pos(G^.InfoDieBox,BoxStr) = 1) or (pos(G^.UserDieBox,BoxStr) = 1) or
  471.              (pos(G^.RubrikStr,BoxStr)  = 1) then
  472.           begin
  473.             RubHeader := true;
  474.             Rubrik := EFillStr(8,B1,CutStr(RestStr(BoxStr)));
  475.           end;
  476.         end;
  477.  
  478.         { Inhaltsverzeichnis fuer DF8MT @DB0GV: }
  479.         { Inhaltsverzeichnis fuer COMPUTER/IBM: }
  480.         if SCon[2] then  (* BBOX *)
  481.         begin
  482.           if pos(G^.InfoBayBox,BoxStr) = 1 then
  483.           begin
  484.             RubHeader := true;
  485.             Zstr := G^.MlStr[3];
  486.             While pos('/',Zstr) > 0 do delete(Zstr,1,pos('/',Zstr));
  487.             While pos(DP,Zstr) > 0 do delete(Zstr,pos(DP ,Zstr),1);
  488.             Rubrik := EFillStr(8,B1,Zstr);
  489.           end;
  490.         end;
  491.  
  492.         if SCon[5] then   (* EBOX *)
  493.         begin
  494.           if (pos(G^.EzFileStr,BoxStr) = 1) or (pos(G^.EzMsgStr,BoxStr) = 1) then
  495.           begin
  496.             RubHeader := true;
  497.             Rubrik := ConstStr(B1,8);
  498.           end;
  499.         end;
  500.  
  501.         if SCon[14] then   (* TBOX *)
  502.         begin
  503.           Zstr := RestStr(BoxStr);
  504.           if (pos(G^.InfoTnc3Box,BoxStr) = 1) and (Zstr[length(Zstr)] = DP) then
  505.           begin
  506.             delete(Zstr,length(Zstr),1);
  507.             RubHeader := true;
  508.             Rubrik := EFillStr(8,B1,Zstr);
  509.           end;
  510.         end;
  511.  
  512.         if RubHeader then
  513.         begin
  514.           if RunHeader
  515.             then BoxStr := GPkt + B1 + Call + B1 + GPkt + B1 + copy(Datum,1,8) + B1 +
  516.                            copy(Uhrzeit,1,5) + B1 + GPkt + B1  + RunRub
  517.             else BoxStr := GPkt + B1 + Call + B1 + GPkt + B1 + copy(Datum,1,8) + B1 +
  518.                            copy(Uhrzeit,1,5) + B1 + GPkt + B1 + G^.RubrikStr + Rubrik;
  519.  
  520.           KillEndBlanks(BoxStr);
  521.           BoxStr := BoxStr + B1;
  522.           if Ord(BoxStr[0]) > 80 then BoxStr[0] := Chr(80);
  523.           BoxStr := EFillStr(79,GPkt,BoxStr) + B2;
  524.           BoxStr[81] := Chr(Attrib[20]);
  525.           Ach := 'R';
  526.         end;
  527.       end;
  528.     end;
  529.  
  530.     if (Art = 1) or Checks or Lists or RubHeader then
  531.     begin
  532.       if length(BoxStr) < 80 then
  533.            BoxStr := EFillStr(80,B1,BoxStr) + Chr(Attrib[18]);
  534.       BoxStr := BoxStr + Ach + Chr(SysArt) + Rubrik;
  535.       Seek(DBox,FSize);
  536.       BlockWrite(DBox,BoxStr[1],1,Result);
  537.       FSize := FilePos(DBox);
  538.       inc(NewChkLst);
  539.     end;
  540.     FillChar(BoxStr,SizeOf(BoxStr),0);
  541.   end;
  542. End;
  543.  
  544.  
  545. Procedure Write_RxFile (* Kanal : Byte; Zeile : String *);
  546. Var     i,i1   : Integer;
  547.         Free   : LongInt;
  548.         Result : Word;
  549.         Hstr   : String[80];
  550.         VC     : Char;
  551.         Bstr   : String;
  552.  
  553. Begin
  554.   with K[Kanal]^ do
  555.   Begin
  556.     case RX_Bin of
  557.  
  558.      1 : begin           (* normales Textfile *)
  559.            if RemoteSave and (MldOk in [16,17]) then
  560.            begin
  561.              CloseRxFile(Kanal,0);
  562.              RX_Save := false;
  563.              RX_Bin := 0;
  564.              RemoteSave := false;
  565.              S_Aus(Kanal,3,M1 + InfoZeile(117) + B1 +
  566.                 int_Str(RX_TextZn) + B1 + InfoZeile(118)+ M1);
  567.              if MsgToMe then
  568.              begin
  569.                MsgToMe := false;
  570.                Eig_Mail_Zeile := '';
  571.                Check_Eig_Mail(1,maxLink);
  572.                if Eig_Mail_Zeile > '' then
  573.                begin
  574.                  InfoOut(show,0,1,InfoZeile(153) + Eig_Mail_Zeile);
  575.                  If Klingel then Triller;
  576.                end;
  577.              end;
  578.              Ignore := false;
  579.              SetzeFlags(Kanal);
  580.              Send_Prompt(Kanal,FF);
  581.            end else
  582.            if RemoteSave and (MldOk = 10) then
  583.            begin
  584.              CloseRxFile(Kanal,0);
  585.              RX_Save := false;
  586.              RX_Bin := 0;
  587.              RemoteSave := false;
  588.              Ignore := false;
  589.              if EraseBin(RXFile) = 0
  590.               then S_Aus(Kanal,3,M1 + Star + InfoZeile(41) + M1);
  591.              SetzeFlags(Kanal);
  592.              Send_Prompt(Kanal,FF);
  593.            end else
  594.            begin
  595.              RX_Count := RX_Count + length(Zeile);
  596.              Zeile := Line_Convert(Kanal,2,Zeile);
  597.              Bstr := '';
  598.              for i := 1 to length(Zeile) do
  599.              Begin
  600.                VC := Zeile[i];
  601.                case VC of
  602.                 ^I  : Bstr := Bstr + VC;
  603.                 M1  : begin
  604.                         Bstr := Bstr + #13 + #10;
  605.                         inc(RX_TextZn);
  606.                       end;
  607.  
  608.                 #1..#31
  609.                     : Bstr := Bstr + '^' + Chr(Ord(VC)+64);
  610.  
  611.                  #0  :;
  612.                  #127:;
  613.  
  614.                 else  Bstr := Bstr + VC;
  615.                end;
  616.  
  617.                if (length(Bstr) > 250) or (i = length(Zeile)) then
  618.                begin
  619.                  BlockWrite(RXFile,Bstr[1],length(Bstr),Result);
  620.                  Bstr := '';
  621.                end;
  622.              End;
  623.  
  624.              FileInfo(Kanal,0,0,RX_Count,0,0);
  625.            end;
  626.          end;
  627.  
  628.      2 : begin  (* normales Binärfile-Empfangen *)
  629.            BlockWrite(RXFile,Zeile[1],length(Zeile),Result);
  630.            RX_Count := RX_Count + length(Zeile);
  631.            FileInfo(Kanal,0,0,RX_Count,0,0);
  632.          end;
  633.  
  634.      5 : begin  (* Automatischer Binärfile-Empfang *)
  635.            if MldOk in [6,10] then
  636.            begin
  637.              if MldOk = 10 then
  638.              begin
  639.                FiResult := CloseBin(RxFile);
  640.                FiResult := EraseBin(RxFile);
  641.                S_PAC(Kanal,NU,false,InfoZeile(41) + M1);
  642.                Send_Prompt(Kanal,FF);
  643.              end else CloseRxFile(Kanal,1);
  644.              RX_Bin := 0;
  645.              RX_Save := false;
  646.              Remotesave := false;
  647.              Ignore := false;
  648.              AutoBinOn := AutoBin;
  649.              SetzeFlags(Kanal);
  650.            end else
  651.            begin
  652.              i1 := length(Zeile);
  653.              if (RX_Count + i1) > RX_Laenge then i1 := Byte(RX_Laenge - RX_Count);
  654.              BlockWrite(RXFile,Zeile[1],i1,Result);
  655.              RX_CRC := Compute_CRC(RX_CRC,copy(Zeile,1,Result));
  656.              RX_Count := RX_Count + i1;
  657.              FileInfo(Kanal,0,RX_Laenge,RX_Count,0,0);
  658.  
  659.              if RX_Count >= RX_Laenge then
  660.              begin
  661.                CloseRxFile(Kanal,0);
  662.                Result := Word(RX_CRC);
  663.                RX_Save := false;
  664.                RX_Bin := 0;
  665.                AutoBinOn := AutoBin;
  666.                Ignore := false;
  667.                SetzeFlags(Kanal);
  668.  
  669.                Hstr := Time_Differenz(RX_Time,Uhrzeit);
  670.                Zeile := FName_aus_FVar(RxFile);
  671.                While pos(BS,Zeile) > 0 do delete(Zeile,1,pos(BS,Zeile));
  672.  
  673.                Zeile := M1 + B1 + InfoZeile(103) + B1 +
  674.                         EFillStr(14,B1,Zeile) + InfoZeile(100) +
  675.                         int_str(Result) + B2 + LRK + Hex(Result,4) + B1 +
  676.                         BdStr + FileBaud(Hstr,int_str(RX_Count)) + B2 +
  677.                         LRK + Hstr + RRK + M1;
  678.  
  679.                if (RX_Soll_CRC > 0) and (Result <> RX_Soll_CRC)
  680.                 then Zeile := Zeile + B1 + InfoZeile(113) + ^G + M1;
  681.                Zeile := Zeile + M1;
  682.  
  683.                if Remotesave and (SysArt = 0) and not FileSend then
  684.                begin
  685.                  S_PAC(Kanal,NU,false,Zeile);
  686.                  Send_Prompt(Kanal,FF);
  687.                end;
  688.                Remotesave := false;
  689.                if RxComp then MeldeCompZ := ''
  690.                          else MeldeZeile := '';
  691.                G^.DZeile := Zeile;
  692.                WeFlag := true;
  693.                if Klingel and BLTON then Beep(900,100);
  694.              end;
  695.            end;
  696.          end;
  697.     end; (* case RX_Bin of ... *)
  698.   End; (* with ... do *)
  699. End;
  700.  
  701.  
  702. Procedure Write_SFile (* Kanal : Byte; Zeile : String *);
  703. Var     i      : Byte;
  704.         Result : Word;
  705.         VC     : Char;
  706.         Flag   : Boolean;
  707.         Hstr   : String;
  708.  
  709. Begin
  710.   Flag := K[Kanal]^.EigFlag or K[Kanal]^.FileFlag or K[Kanal]^.RemFlag;
  711.  
  712.   Zeile := Line_Convert(Kanal,2,Zeile);
  713.   Hstr := '';
  714.   for i := 1 to length(Zeile) do
  715.   Begin
  716.     VC := Zeile[i];
  717.  
  718.     if Flag and (Kanal > 0) and K[Kanal]^.SvLRet then Hstr := Hstr + EchoCh + B1;
  719.     K[Kanal]^.SvLRet := false;
  720.  
  721.     case VC of
  722.      ^I  : Hstr := Hstr + VC;
  723.      ^J  : if Kanal = 0 then Hstr := Hstr + #13 + #10;
  724.      M1  : begin
  725.              if (Kanal = 0) and ZeigeRET then Hstr := Hstr + '^' + Chr(Ord(^J)+64);
  726.              Hstr := Hstr + #13 + #10;
  727.              K[Kanal]^.SvLRet := true;
  728.            end;
  729.      #0  :;
  730.      #127:;
  731.      #1..#31
  732.          : Hstr := Hstr + '^' + Chr(Ord(VC)+64)
  733.      else  Hstr := Hstr + VC;
  734.     end;
  735.  
  736.     if (length(Hstr) > 250) or (i = length(Zeile)) then
  737.     begin
  738.       BlockWrite(K[Kanal]^.SFile,Hstr[1],length(Hstr),Result);
  739.       Hstr := '';
  740.     end;
  741.   End;
  742. End;
  743.  
  744.  
  745. Procedure Write_SplFile (* Kanal : Byte; Zeile : String *);
  746. Type    FPtr   = Array [1..500] of Char;
  747.  
  748. Var     i      : Byte;
  749.         Result : Word;
  750.         Count  : Word;
  751.         ch     : Char;
  752.         Feld   : ^FPtr;
  753. Begin
  754.   with K[Kanal]^ do
  755.   begin
  756.     GetMem(Feld,SizeOf(Feld^));
  757.     FillChar(Feld^,SizeOf(Feld^),0);
  758.     Count := 0;
  759.     for i := 1 to length(Zeile) do
  760.     Begin
  761.       ch := Zeile[i];
  762.       case ch of
  763.        ^J : ;
  764.  
  765.        M1 : begin
  766.               inc(Count);
  767.               Feld^[Count] := #13;
  768.               inc(Count);
  769.               Feld^[Count] := #10;
  770.             end;
  771.  
  772.       else  begin
  773.               inc(Count);
  774.               Feld^[Count] := ch;
  775.               if not Spl_COR_ERR then
  776.               begin
  777.                 inc(Spl_gCount);
  778.                 inc(Spl_tCount);
  779.               end;
  780.             end;
  781.       end;
  782.     End;
  783.     BlockWrite(SplFile,Feld^,Count,Result);
  784.     FreeMem(Feld,SizeOf(Feld^));
  785.  
  786.     if not Spl_COR_ERR then
  787.       FileInfo(Kanal,2,Spl_gLaenge,Spl_gCount,Spl_tLaenge,Spl_tCount);
  788.   end;
  789. End;
  790.  
  791.  
  792. Procedure WriteBuffer (* Kanal : Byte; Zeile : String *);
  793. var    Result : Word;
  794. Begin
  795.   with K[Kanal]^ do if BufExists then
  796.   begin
  797.     Seek(BufFile,FileSize(BufFile));
  798.     BlockWrite(BufFile,Zeile[1],length(Zeile),Result);
  799.   end;
  800. End;
  801.  
  802.  
  803. Procedure SendBuffer (* Kanal : Byte *);
  804. Var    Result  : Word;
  805.        Zeile   : String;
  806.        BufTill : LongInt;
  807.        BufStr  : String[10];
  808. Begin
  809.   with K[Kanal]^ do if BufExists then
  810.   begin
  811.     Seek(BufFile,BufPos);
  812.     BlockRead(BufFile,Zeile[1],PacLen,Result);
  813.     BufPos := FilePos(BufFile);
  814.  
  815.     BufStr := '';
  816.     BufTill := FileSize(BufFile) - BufPos;
  817.     if BufTill > 9999 then
  818.     begin
  819.       BufTill := BufTill div 1024;
  820.       BufStr := 'K';
  821.     end;
  822.     if BufTill > 9999 then
  823.     begin
  824.       BufTill := BufTill div 1024;
  825.       BufStr := 'M';
  826.     end;
  827.     BufStr := int_str(BufTill) + BufStr;
  828.     StatusOut(Kanal,6,4,Attrib[7],SFillStr(5,B1,BufStr));
  829.  
  830.     if Result > 0 then
  831.     begin
  832.       Zeile[0] := chr(Result);
  833.       TxRxTNC(Kanal,0,Zeile);
  834.     end else EraseBufferFile(Kanal);
  835.   end;
  836. End;
  837.  
  838.  
  839. Procedure Morse (* Kanal : Byte; Zeile : str80 *);
  840. var    i,i1,i2 : Byte;
  841.        VC      : char;
  842. Begin
  843.   for i := 1 to length(Zeile) do
  844.   begin
  845.     VC := UpCase(Zeile[i]);
  846.     i1 := 1;
  847.     LockIntFlag(0);
  848.     While (i1 < maxMorAnz) and (Mchs[i1].Ze <> VC) do inc(i1);
  849.     if Mchs[i1].Ze = VC then
  850.     begin
  851.       for i2 := 1 to length(Mchs[i1].Co) do
  852.       begin
  853.         case Mchs[i1].Co[i2] of
  854.           Pkt  : Beep(G^.Tonhoehe,MPause);
  855.           '-' : Beep(G^.Tonhoehe,3 * MPause);
  856.         end;
  857.         Verzoegern(MPause);
  858.       end;
  859.       Verzoegern(2 * MPause);
  860.     end else
  861.     if VC = B1 then Verzoegern(7 * MPause) else
  862.     begin
  863.       Sound((G^.Tonhoehe div 3) * 2);
  864.       Verzoegern(MPause);
  865.       NoSound;
  866.       Verzoegern(MPause);
  867.     end;
  868.     LockIntFlag(1);
  869.   end;
  870. End;
  871.  
  872.  
  873. Function Compress (* Zeile : String) : String *);
  874. Var   Hstr : String;
  875.       t    : Word;
  876.       s    : Word;
  877.       i    : Byte;
  878.       a    : Integer;
  879.       b,c  : Byte;
  880.       ch   : Char;
  881.       long : Boolean;
  882. Begin
  883.   FillChar(Hstr,SizeOf(Hstr),0);
  884.   a := 7;
  885.   b := 1;
  886.   long := false;
  887.  
  888.   i := 0;
  889.   While (i < length(Zeile)) and not long do
  890.   begin
  891.     inc(i);
  892.     t := HTable[ord(Zeile[i])].Tab;
  893.     s := $8000;
  894.     C := 0;
  895.  
  896.     While (C < HTable[ord(Zeile[i])].Len) and not long do
  897.     begin
  898.       inc(C);
  899.       if t and s = s then Hstr[b] := Chr(ord(Hstr[b]) + 1 shl a);
  900.       s := s shr 1;
  901.       dec(a);
  902.       if a < 0 then
  903.       begin
  904.         a := 7;
  905.         inc(b);
  906.         if b > 254 then long := true;
  907.       end;
  908.     end;
  909.     Hstr[0] := chr(b);
  910.   end;
  911.  
  912.   if (length(Hstr) > length(Zeile)) or long then
  913.   begin
  914.     Hstr := Zeile[0] + Zeile;
  915.     ch := #255;
  916.   end else ch := Chr(length(Hstr));
  917.   Compress := ch + Hstr;
  918. End;
  919.  
  920.  
  921. Function DeCompress (* Zeile : String) : String *);
  922. Var   Hstr  : String;
  923.       b,i,l : Byte;
  924.       a     : Integer;
  925.       t,t2  : Word;
  926.       Bit   : LongInt;
  927.       ch    : Char;
  928.  
  929. Begin
  930.   ch := Zeile[1];
  931.   delete(Zeile,1,1);
  932.   if ch = #255 then delete(Zeile,1,1);
  933.   if (ch < #255) and (Zeile[0] > #0) then
  934.   begin
  935.     Hstr := '';
  936.     l := 0;
  937.     Bit := 0;
  938.  
  939.     for i := 1 to length(Zeile) do
  940.     begin
  941.       Bit := (Bit shl 8) or ord(Zeile[i]);
  942.       l := Byte(l + 8);
  943.  
  944.       a := 0;
  945.  
  946.       Repeat
  947.         b := HTable[a].Len;
  948.         if l >= b then
  949.         begin
  950.           t := HTable[a].Tab;
  951.           t2 := Word(Bit shr (l-b)) shl (16-b);
  952.  
  953.           if t = t2 then
  954.           begin
  955.             Hstr := Hstr + chr(a);
  956.             l := l - b;
  957.             a := -1;
  958.           end;
  959.         end;
  960.         inc(a);
  961.       Until (a > 257) or (l < 3);
  962.     end;
  963.   end else Hstr := Zeile;
  964.   DeCompress := Hstr;
  965. End;
  966.